home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / ifp1s157.zip / PAGE_03.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-26  |  11KB  |  375 lines
  1. unit page_03;
  2.  
  3. interface
  4.  
  5. uses Crt, Dos, ifpglobl, ifpcomon, ifpextrn;
  6.  
  7. procedure page03;
  8.  
  9. implementation
  10.  
  11. procedure page03;
  12.  
  13. const
  14.   EMMint = $67;
  15.   qEMMdrvr = 'EMMXXXX0';
  16.   EMMerrs : array [$80..$A4] of string[55] = (
  17.         {80} 'internal error in EMM software',
  18.              'malfunction in expanded memory hardware',
  19.              'memory manager busy',
  20.              'invalid handle',
  21.              'undefined function',
  22.              'no more handles available',
  23.              'error in save or restore of mapping context',
  24.              'not enough physical pages available',
  25.         {88} 'not enough free pages available',
  26.              'no pages requested',
  27.              'logical page outside range assigned to handle',
  28.              'invalid physical page number',
  29.              'page map hardware state save area full',
  30.              'mapping context already in save area',
  31.              'mapping context not in save area',
  32.              'undefined subfunction parameter',
  33.         {90} 'attribute type not defined',
  34.              'feature not supported',
  35.              'src & dest overlap;move done, but source overwritten',
  36.              'length for src or dest longer than allocated',
  37.              'conventional and EMS memory overlap',
  38.              'offset outside logical page',
  39.              'region length >1M',
  40.              'src & dest overlap;not moved',
  41.         {98} 'src & dest types undefined',
  42.              'unused erro code',
  43.              'Alt map or DMA supported, but specified set isn''t',
  44.              'Alt map or DMA supported, but all allocated',
  45.              'Alt map or DMA not suported, specified set <> 0',
  46.              'Alt map or DMA suported, specified set <> 0',
  47.              'Dedicated DMA channels not supported',
  48.              'Dedicated DMA channels supported, but not specified one',
  49.         {A0} 'No handle found for specified name',
  50.              'handle with same name already exists',
  51.              '???',
  52.              'invalid pointer passed, or contents of source corrupted',
  53.              'access to function denied');
  54.  
  55. var
  56.   EMMarray : array[$000..$3FF] of word;
  57.   xlong : longint;
  58.   xword1 : word;
  59.   xword2 : word;
  60.   numhandles: word;
  61.   xstring : string;
  62.   EMMver, j: byte;
  63.   EMMname: array[1..8] of char;
  64.   isdpmi: boolean;
  65.   direc: directions;
  66.   ch2: char2;
  67.  
  68.   procedure EMMerr(a : byte);
  69.     begin
  70.     if (a >= $80) and (a <= $8F) then
  71.       Writeln(EMMerrs[a])
  72.     else
  73.       unknown('expanded memory error', a, 2)
  74.     end; {EMMerr}
  75.  
  76.   procedure showbcd(x: word);
  77.     var
  78.       c: char;
  79.  
  80.     begin
  81.     c:=Chr((x shr 12) + 48);
  82.     if c <> '0' then
  83.       Write(c);
  84.     Write(Chr(((x and $0F00) shr 8) + 48), decimal,
  85.       Chr(((x and $00F0) shr 4) + 48), Chr((x and $000F) + 48))
  86.     end; {showbcd}
  87.  
  88.   begin (* procedure page_03 *)
  89.   Caption2('Total conventional memory (bytes)  ');
  90.   Writeln(DOSmem: 6, ' (', DOSmem div 1024, 'K)');
  91.   Caption2('Free conventional memory (bytes)   ');
  92.   xlong:=DOSmem - (longint(PrefixSeg) shl 4);
  93.   Writeln(xlong: 6, ' (', xlong div 1024, 'K)');
  94.   Caption2('Extended memory (from BIOS call) ');
  95.   with regs do begin
  96.     AH:=$88;
  97.     Flags:=Flags and FCarry;
  98.     Intr($15, regs);
  99.     if nocarry(regs) then
  100.       Writeln(longint(AX) shl 10:8, ' (', AX, 'K)')
  101.     else
  102.       Writeln('     N/A')
  103.   end;
  104.   Caption2('XMS driver present ');
  105.   with regs do
  106.     begin
  107.     AX:=$4300;
  108.     Intr($2F, regs);
  109.     if AL <> $80 then
  110.       Writeln('no')
  111.     else
  112.       begin
  113.       Writeln('yes');
  114.       AX:=$4310;
  115.       Intr($2F, regs);
  116.       xlong:=longint(ES) shl 16 + BX;
  117.       Caption3('XMS version');
  118.       AX:=0;
  119.       longcall(xlong, regs);
  120.       if AX <> 0 then
  121.         begin
  122.         showbcd(AX);
  123.         Caption3('XMM version');
  124.         showbcd(BX);
  125.         end
  126.       else
  127.         Write('ERROR');
  128.       Caption3('A20 is');
  129.       AX:=$0700;
  130.       longcall(xlong, regs);
  131.       if (AX <> 0) or ((AX = 0) and (BL = 0)) then
  132.         case AX of
  133.           0: Writeln('disabled');
  134.           1: Writeln('enabled');
  135.         else
  136.           Writeln('unknown');
  137.         end
  138.       else
  139.         Write('ERROR');
  140.       Caption3('Total free XMS memory');
  141.       AX:=$0800;
  142.       longcall(xlong, regs);
  143.       if (AX <> 0) or ((AX = 0) and ((BL = 0) or (BL = $A0))) then
  144.         begin
  145.         Write(DX, 'K');
  146.         Caption3('Largest available block');
  147.         Writeln(AX, 'K');
  148.         end
  149.       else
  150.         Writeln('ERROR');
  151.       Caption3('Upper memory Blocks');
  152.       AX:=$1000;
  153.       DX:=1;
  154.       longcall(xlong, regs);
  155.       if (AX = 0) and (BL <> $B1) then
  156.         Writeln('no')
  157.       else
  158.         if (AX = 0) and (BL = $B1) then
  159.           Writeln('supported, but none available')
  160.         else
  161.           begin
  162.           Write('yes');
  163.           Caption3('Largest available size');
  164.           AX:=$1100;
  165.           DX:=BX;
  166.           longcall(xlong, regs);
  167.           AX:=$1000;
  168.           DX:=$FFFF;
  169.           longcall(xlong, regs);
  170.           Writeln(DX * longint(16), ' (', ((DX * 16.0) / 1024):1:1, 'K)');
  171.           end;
  172.       AX:=0;
  173.       longcall(xlong, regs);
  174.       Caption3('HMA');
  175.       YesOrNo2(DX = 1);
  176.       AX:=$0100;
  177.       DX:=$FFFF;
  178.       longcall(xlong, regs);
  179.       if AX = 0 then
  180.         Write(' (in use)')
  181.       else
  182.         Write(' (free)');
  183.       if (osmajor >= 5) and (osmajor < 10) then
  184.         begin
  185.         Caption3('Used by DOS');
  186.         AX:=$4A01;
  187.         Intr($2F, regs);
  188.         YesOrNo2(BX <> 0);
  189.         if BX <> 0 then
  190.           begin
  191.           Caption3('bytes free');
  192.           Write(BX);
  193.           Caption3('at');
  194.           SegOfs(ES, DI);
  195.           end;
  196.         end;
  197.       Writeln;
  198.       end;
  199.     end;
  200.   isdpmi:=false;
  201.   Caption2('DPMI driver present');
  202.   with regs do
  203.     begin
  204.     AX:=$1687;
  205.     Intr($2F, regs);
  206.     if AX <> 0 then
  207.       Writeln('no')
  208.     else
  209.       begin
  210.       Writeln('yes');
  211.       isdpmi:=true;
  212.       Caption3('version');
  213.       Write(DH, decimal, DL);
  214.       Caption3('CPU');
  215.       case CL of
  216.         2: Write('286');
  217.         3: Write('386');
  218.         4: Write('486');
  219.         5: Write('P5')
  220.       else
  221.         Write('???')
  222.       end;
  223.       Caption3('switch mode entry');
  224.       SegOfs(ES, DI);
  225.       Writeln
  226.       end
  227.     end;
  228.   pause3(-12);
  229.   if endit then
  230.     Exit;
  231.   Caption2('Expanded memory');
  232.   if longint(intvec[EMMint]) <> $00000000 then
  233.     begin
  234.     Writeln;
  235.     Caption3('Interrupt vector');
  236.     xlong:=longint(intvec[EMMint]);
  237.     xword1:=xlong shr 16;
  238.     xword2:=xlong and $0000FFFF;
  239.     SegOfs(xword1, xword2);
  240.     Writeln;
  241.     Caption3('Driver');
  242.     xstring:='';
  243.     for i:=$000A to $0011 do
  244.       xstring:=xstring + showchar(Chr(Mem[xword1 : i]));
  245.     Write(xstring);
  246.     if xstring = qEMMdrvr then
  247.       begin
  248.       Caption3('status');
  249.       with regs do
  250.         begin
  251.         AH:=$40;
  252.         Intr(EMMint, regs);
  253.         if AH = $00 then
  254.           Write('available')
  255.         else
  256.           EMMerr(AH);
  257.         Caption3('version');
  258.         AH:=$46;
  259.         Intr(EMMint, regs);
  260.         if AH = $00 then
  261.           Writeln(AL shr 4, decimal, AL and $0F)
  262.         else
  263.           EMMerr(AH);
  264.         EMMver:=AL shr 4;
  265.         Caption3('Page frame segment');
  266.         AH:=$41;
  267.         Intr(EMMint, regs);
  268.         if AH = $00 then
  269.           Writeln(Hex(BX, 4))
  270.         else
  271.           EMMerr(AH);
  272.         Caption3('Total EMS memory');
  273.         AH:=$42;
  274.         Intr(EMMint, regs);
  275.         if AH = $00 then
  276.           begin
  277.           Write(longint(16) * DX, 'K');
  278.           Caption3('available');
  279.           if AH = $00 then
  280.             Writeln(longint(16) * BX, 'K')
  281.           else
  282.             EMMerr(AH)
  283.           end
  284.         else
  285.           EMMerr(AH);
  286.         if EMMver >= 4 then
  287.           begin
  288.           Caption3('VCPI capable');
  289.           {Check if Windows in enhanced mode. Don't do VCPI check if found.}
  290.           AX:=$1600;
  291.           Intr($2F, regs);
  292.           if AL in [0, 1, $80, $FF] then
  293. {          if not isdpmi then}
  294.             begin
  295.             {must make sure 1 page is allocated to be sure that EMS}
  296.             {driver is ON. VCPI is not detectable if EMS driver is OFF}
  297.             {16K of EMS needed for this test to work properly}
  298.             AH:=$43;
  299.             BX:=1;
  300.             Intr(EMMint, regs);
  301.             if AH <> 0 then
  302.               Writeln('error: need 16K available EMS to detect')
  303.             else
  304.               begin
  305.               xword1:=DX; {handle}
  306.               AX:=$DE00;
  307.               Intr(EMMint, regs);
  308.               if AH <> 0 then
  309.                 Writeln('no')
  310.               else
  311.                 begin
  312.                 Write('yes');
  313.                 Caption3('VCPI version');
  314.                 Writeln(BH, decimal, BL);
  315.                 end;
  316.               AH:=$45; {release our handle}
  317.               DX:=xword1;
  318.               Intr(EMMint, regs)
  319.               end
  320.             end
  321.           else
  322.             Writeln('no');
  323.           end;
  324.         Caption1('  Handle   Size  Name');
  325.         Writeln;
  326.         AH:=$4D;
  327.         ES:=seg(EMMarray);
  328.         DI:=ofs(EMMarray);
  329.         Intr(EMMint, regs);
  330.         if AH = $00 then
  331.           if BX > $0000 then
  332.             begin
  333.             Window(3, WhereY + Hi(WindMin), twidth, tlength - 2);
  334.             numhandles:=BX;
  335.             for i:=1 to numhandles do
  336.               begin
  337.               pause2;
  338.               if endit then
  339.                 Exit;
  340.               xlong:=longint(16) * EMMarray[2 * i - 1];
  341.               if xlong > 0 then
  342.                 begin
  343.                 Write(Hex(EMMarray[2 * i - 2], 4), '   ', xlong:5, 'K  ');
  344.                 if EMMver >= 4 then
  345.                   begin
  346.                   AX:=$5300;
  347.                   DX:=EMMarray[2 * i - 2];
  348.                   ES:=Seg(EMMname);
  349.                   DI:=Ofs(EMMname);
  350.                   Intr(EMMint, regs);
  351.                   if AH = 0 then
  352.                     for j:=1 to 8 do
  353.                       if EMMname[j] <> #0 then
  354.                         Write(EMMname[j]);
  355.                   end;
  356.                 Writeln;
  357.                 end;
  358.               end;
  359.             end
  360.           else
  361.             Writeln('  (no active handles)')
  362.         else
  363.           EMMerr(AH)
  364.         end
  365.       end
  366.     else
  367.       begin
  368.       Writeln;
  369.       dontknow
  370.       end
  371.     end
  372.   else
  373.     Writeln('(none)')
  374.   end;
  375. end.